home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / WINFONTS / WSFONT.ZIP / WSFONTS.FRM < prev    next >
Text File  |  1993-10-04  |  10KB  |  362 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "Font Manager"
  6.    FillColor       =   &H00C0C0C0&
  7.    FillStyle       =   5  'Downward Diagonal
  8.    ForeColor       =   &H00000000&
  9.    Height          =   4470
  10.    Icon            =   WSFONTS.FRX:0000
  11.    Left            =   2160
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    ScaleHeight     =   3780
  15.    ScaleWidth      =   7890
  16.    Top             =   1725
  17.    Width           =   8010
  18.    Begin CommonDialog CMDialog1 
  19.       Left            =   3600
  20.       Top             =   120
  21.    End
  22.    Begin CommandButton Command1 
  23.       BackColor       =   &H00FF0000&
  24.       Caption         =   "τ"
  25.       FontBold        =   0   'False
  26.       FontItalic      =   0   'False
  27.       FontName        =   "Wingdings"
  28.       FontSize        =   8.25
  29.       FontStrikethru  =   0   'False
  30.       FontUnderline   =   0   'False
  31.       Height          =   375
  32.       Index           =   1
  33.       Left            =   3480
  34.       TabIndex        =   3
  35.       Top             =   1800
  36.       Width           =   855
  37.    End
  38.    Begin CommandButton Command1 
  39.       BackColor       =   &H00FF0000&
  40.       Caption         =   "Φ"
  41.       FontBold        =   0   'False
  42.       FontItalic      =   0   'False
  43.       FontName        =   "Wingdings"
  44.       FontSize        =   8.25
  45.       FontStrikethru  =   0   'False
  46.       FontUnderline   =   0   'False
  47.       Height          =   375
  48.       Index           =   0
  49.       Left            =   3480
  50.       TabIndex        =   2
  51.       Top             =   1080
  52.       Width           =   855
  53.    End
  54.    Begin ListBox List2 
  55.       FontBold        =   0   'False
  56.       FontItalic      =   0   'False
  57.       FontName        =   "MS Sans Serif"
  58.       FontSize        =   8.25
  59.       FontStrikethru  =   0   'False
  60.       FontUnderline   =   0   'False
  61.       Height          =   2760
  62.       Left            =   4440
  63.       MultiSelect     =   2  'Extended
  64.       Sorted          =   -1  'True
  65.       TabIndex        =   5
  66.       Top             =   480
  67.       Width           =   3300
  68.    End
  69.    Begin ListBox List1 
  70.       FontBold        =   0   'False
  71.       FontItalic      =   0   'False
  72.       FontName        =   "MS Sans Serif"
  73.       FontSize        =   8.25
  74.       FontStrikethru  =   0   'False
  75.       FontUnderline   =   0   'False
  76.       Height          =   2760
  77.       Left            =   120
  78.       MultiSelect     =   2  'Extended
  79.       Sorted          =   -1  'True
  80.       TabIndex        =   1
  81.       Top             =   480
  82.       Width           =   3300
  83.    End
  84.    Begin Label Label2 
  85.       AutoSize        =   -1  'True
  86.       BackStyle       =   0  'Transparent
  87.       Caption         =   "label2"
  88.       FontBold        =   0   'False
  89.       FontItalic      =   0   'False
  90.       FontName        =   "MS Sans Serif"
  91.       FontSize        =   8.25
  92.       FontStrikethru  =   0   'False
  93.       FontUnderline   =   0   'False
  94.       Height          =   195
  95.       Left            =   120
  96.       TabIndex        =   6
  97.       Top             =   3555
  98.       Width           =   420
  99.    End
  100.    Begin Line Line2 
  101.       BorderColor     =   &H00808080&
  102.       X1              =   1560
  103.       X2              =   3840
  104.       Y1              =   3480
  105.       Y2              =   3480
  106.    End
  107.    Begin Line Line1 
  108.       BorderColor     =   &H00FFFFFF&
  109.       X1              =   2520
  110.       X2              =   6240
  111.       Y1              =   3480
  112.       Y2              =   3480
  113.    End
  114.    Begin Label Label1 
  115.       AutoSize        =   -1  'True
  116.       BackStyle       =   0  'Transparent
  117.       Caption         =   "&Reserve Fonts:"
  118.       ForeColor       =   &H00000000&
  119.       Height          =   195
  120.       Index           =   1
  121.       Left            =   4440
  122.       TabIndex        =   4
  123.       Top             =   240
  124.       Width           =   1305
  125.    End
  126.    Begin Label Label1 
  127.       AutoSize        =   -1  'True
  128.       BackStyle       =   0  'Transparent
  129.       Caption         =   "&Installed Fonts:"
  130.       ForeColor       =   &H00000000&
  131.       Height          =   195
  132.       Index           =   0
  133.       Left            =   120
  134.       TabIndex        =   0
  135.       Top             =   225
  136.       Width           =   1320
  137.    End
  138.    Begin Menu fMenu 
  139.       Caption         =   "&File"
  140.       Begin Menu fItem 
  141.          Caption         =   "P&rint Setup..."
  142.          Index           =   0
  143.       End
  144.       Begin Menu fItem 
  145.          Caption         =   "-"
  146.          Index           =   1
  147.       End
  148.       Begin Menu fItem 
  149.          Caption         =   "E&xit"
  150.          Index           =   2
  151.       End
  152.    End
  153. End
  154. Option Explicit
  155. Option Compare Text
  156. DefInt A-Z
  157. Dim bf$(22)
  158.  
  159. Sub BuildBasics ()
  160. bf$(0) = "Arial (TrueType)"
  161. bf$(1) = "Arial Bold (TrueType)"
  162. bf$(2) = "Arial Bold Italic (TrueType)"
  163. bf$(3) = "Arial Italic (TrueType)"
  164. bf$(4) = "Courier New (TrueType)"
  165. bf$(5) = "Courier New Bold (TrueType)"
  166. bf$(6) = "Courier New Bold Italic (TrueType)"
  167. bf$(7) = "Courier New Italic (TrueType)"
  168. bf$(8) = "Times New Roman (TrueType)"
  169. bf$(9) = "Times New Roman Bold (TrueType)"
  170. bf$(10) = "Times New Roman Bold Italic (TrueType)"
  171. bf$(11) = "Times New Roman Italic (TrueType)"
  172. bf$(12) = "Wingdings (TrueType)"
  173. bf$(13) = "Symbol (TrueType)"
  174. bf$(14) = "System"
  175. bf$(15) = "Modern (Plotter)"
  176. bf$(16) = "Roman (Plotter)"
  177. bf$(17) = "Script (Plotter)"
  178. bf$(18) = "Terminal"
  179. bf$(19) = "Symbol 8"
  180. bf$(20) = "MS Sans Serif"
  181. bf$(21) = "MS Serif"
  182. bf$(22) = "Small ("
  183. End Sub
  184.  
  185. Sub Callback1_EnumFonts (lpLogFont As Long, lpTextMetrics As Long, nFontTYpe As Integer, lpData As Long, Retval As Integer)
  186. Debug.Print lpLogFont, lpTextMetrics, nFontTYpe, lpData, Retval
  187. End Sub
  188.  
  189. Function CheckBasics% (fName$)
  190. Dim X%
  191. CheckBasics% = False
  192. For X% = 0 To 19
  193.    If fName$ = bf$(X%) Then CheckBasics% = True: Exit Function
  194. '   If fName$ + " (TrueType)" = bf$(X%) Then CheckBasics% = True: Exit Function
  195. Next
  196. For X% = 20 To 22
  197.    If InStr(fName$, bf$(X%)) Then CheckBasics% = True: Exit Function
  198. Next
  199. End Function
  200.  
  201. Sub CheckReserveListCount ()
  202. If List2.ListCount > 0 Then
  203.    Command1(1).Enabled = True
  204. Else
  205.    Command1(1).Enabled = False
  206. End If
  207. End Sub
  208.  
  209. Sub Command1_Click (Index As Integer)
  210. Command1(0).Enabled = False
  211. Command1(1).Enabled = False
  212. Dim y%, Z%, F$, fc%
  213. Screen.MousePointer = 11
  214. Select Case Index
  215. Case 0   'move to wsfonts
  216.    For y% = List1.ListCount - 1 To 0 Step -1
  217.       MoveBasic% = True
  218.       If List1.Selected(y%) Then
  219.          F$ = List1.List(y%)
  220.          Z% = CheckBasics%(F$)
  221.          If Z% = True Then
  222.             TestFont$ = F$
  223.             Screen.MousePointer = 0
  224.             ConfirmScreen.Show 1
  225.             Screen.MousePointer = 11
  226.          End If
  227.          If MoveBasic% = True Then
  228.             Label2 = "Deactivating " + F$
  229.             Label2.Refresh
  230.             If UninStall%(F$) = True Then
  231.                List2.AddItem F$
  232.                List1.RemoveItem y%
  233.             End If
  234.          End If
  235.       End If
  236.    Next
  237. Case 1   'install
  238.    For y% = List2.ListCount - 1 To 0 Step -1
  239.       If List2.Selected(y%) Then
  240.          F$ = List2.List(y%)
  241.          Label2 = "Activating " + F$
  242.          Label2.Refresh
  243.          If Install%(F$) = True Then
  244.             List1.AddItem F$
  245.             List2.RemoveItem y%
  246.          End If
  247.       End If
  248.    Next
  249. End Select
  250. BroadcastIniChange
  251. CheckReserveListCount
  252. Label2 = ""
  253. Screen.MousePointer = 0
  254. Command1(0).Enabled = True
  255. Command1(1).Enabled = True
  256.  
  257. End Sub
  258.  
  259. Sub fItem_Click (Index As Integer)
  260. Select Case Index
  261. Case 0
  262.       CMDialog1.Flags = &H40&
  263.       CMDialog1.PrinterDefault = True
  264.       CMDialog1.CancelError = True
  265.       On Error Resume Next
  266.       CMDialog1.Action = 5
  267.       If Err = 32755 Then Exit Sub
  268.       On Error GoTo 0
  269. Case 1
  270. Case 2
  271.    Unload Me
  272. End Select
  273. End Sub
  274.  
  275. Sub Form_Load ()
  276. Label2 = ""
  277. CRLF$ = Chr$(13) + Chr$(10)
  278. Screen.MousePointer = 11
  279. Show
  280. Refresh
  281. BuildBasics
  282. Dim X%, Temp$, Z%
  283. 'load installed fonts from Win.INI
  284. Z% = 1
  285. Temp$ = ListWinIniEntries$("Fonts")
  286. X% = InStr(Te